home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / pow_tb.zip / TBWRAP1.PRG < prev   
Text File  |  1993-05-14  |  4KB  |  161 lines
  1.    /* tbWrap1.prg: Browses supplier.dbf with the long field of 
  2.    product details word wrapped into column 2. This was a real mind
  3.    bender, and took me absolutely ages to figure out, but it turned 
  4.    out to be really neat in the end. Hotter stuff!!
  5.    
  6.    Copyright (C) Dave Boettcher 1993. This source code, and functional 
  7.    fragments thereof, may only be distributed unchanged and as part of 
  8.    the file POWER_TB.ARJ. See POWER_TB.TXT for full copyright details.
  9.    
  10.    Last change:  14 May 93       6:52 pm
  11.    */
  12.    
  13.    #include "setcurs.ch"
  14.    #include "inkey.ch"
  15.    #include "box.ch"
  16.    
  17.    static nLineLength := 50
  18.    static nLineNumber := 1
  19.    static nLines
  20.    
  21. function main()
  22.    
  23.    local oBrowse
  24.    local oColumn
  25.    local nKey
  26.    local lCont := .T.
  27.    local oldColour := setcolor("w+/b")
  28.    local oldCursor := setcursor(SC_NONE)
  29.    local bLineCount   
  30.    
  31.    use supplier new
  32.    bLineCount := {|| mlcount(alltrim(supplier->product), nLineLength)+1}
  33.    nLines := eval(bLineCount)
  34.    
  35.    clear screen
  36.    @ 0, 0, 24, 79 box B_DOUBLE
  37.    
  38.    oBrowse := tbrowsedb(1, 1, 23, 78)
  39.    oBrowse:headsep   := "─┬─"
  40.    oBrowse:colsep    := " │ "
  41.    oBrowse:goBottomBlock := { || dbGoBottom(), nLineNumber := nLines:= eval(bLineCount)}
  42.    oBrowse:goTopBlock := { || dbGoTop(), nLineNumber := 1, nLines := eval(bLineCount)  }
  43.    oBrowse:skipBlock := { |nRequest| multiskip(nRequest, bLineCount) }   
  44.    
  45.    oColumn := TBColumnNew("Supplier", {|| col1Conts() })
  46.    oColumn:width := 20
  47.    oColumn:footsep := "─┴─"
  48.    oBrowse:AddColumn(oColumn)
  49.    
  50.    oColumn := TBColumnNew("Product", {|| col2Conts(nLineNumber)} )
  51.    oColumn:width := nLineLength   
  52.    oColumn:footsep := "─┴─"
  53.    oBrowse:AddColumn(oColumn)
  54.    
  55.    do while lCont
  56.       
  57.       do while .not. oBrowse:stable .AND. (nKey := InKey()) == 0
  58.          oBrowse:Stabilize()
  59.       enddo
  60.       
  61.       if oBrowse:stable
  62.          if (oBrowse:hitTop .OR. oBrowse:hitBottom)
  63.             Tone(125,0)
  64.          endif
  65.          nKey := InKey(0)
  66.       endif
  67.       
  68.       Do Case
  69.          Case nKey == K_DOWN        ;  oBrowse:Down()
  70.          Case nKey == K_UP          ;  oBrowse:Up()
  71.          Case nKey == K_LEFT        ;  oBrowse:Left()
  72.          Case nKey == K_RIGHT       ;  oBrowse:Right()
  73.          Case nKey == K_PGDN        ;  oBrowse:PageDown()
  74.          Case nKey == K_PGUP        ;  oBrowse:PageUp()
  75.          Case nKey == K_CTRL_PGUP   ;  oBrowse:GoTop()
  76.          Case nKey == K_CTRL_PGDN   ;  oBrowse:GoBottom()
  77.          Case nKey == K_ESC         ;  lCont := .F.
  78.       endcase
  79.       
  80.    enddo
  81.    
  82.    setcolor(oldColour)
  83.    setcursor(oldCursor)
  84.    clear screen
  85.    
  86.    return nil
  87.    
  88.    
  89. function col1Conts
  90.    
  91.    local cStr
  92.    
  93.    do case
  94.       case nLineNumber == 1
  95.          cStr := supplier->name
  96.       case nLineNumber != 1
  97.          cStr := " "
  98.    endcase
  99.    
  100.    return cStr
  101.    
  102.    
  103. function col2Conts(nLineNumber)
  104.    
  105.    local cStr
  106.    
  107.    do case
  108.       case nLineNumber < nLines
  109.          cStr := memoline(supplier->product, nLineLength, nLineNumber)
  110.       case nLineNumber == nLines
  111.          cStr := replicate("-", nLineLength)
  112.    endcase
  113.    
  114.    return cStr
  115.    
  116.    
  117. function MultiSkip( nRequested, bLineCount )
  118.    
  119.    local nAllowed := 0
  120.    
  121.    if nRequested > 0
  122.       
  123.       do while (!eof()) .and. nAllowed < nRequested
  124.          
  125.          nAllowed++
  126.          nLineNumber++
  127.          
  128.          if nLineNumber > nLines
  129.             skip 1
  130.             nLineNumber := 1
  131.             nLines := eval(bLineCount)
  132.          endif
  133.       enddo
  134.       
  135.       if eof()
  136.          nAllowed--
  137.          skip -1
  138.          nLineNumber := nLines := eval(bLineCount)
  139.       endif
  140.       
  141.    elseif nRequested < 0
  142.       
  143.       do while (!bof()) .and. nAllowed > nRequested
  144.          
  145.          nAllowed--
  146.          nLineNumber--
  147.          
  148.          if nLineNumber == 0
  149.             skip -1
  150.             nLineNumber := nLines := eval(bLineCount)
  151.          endif
  152.       enddo
  153.       
  154.       if bof()
  155.          nAllowed++
  156.          nLineNumber := 1
  157.       endif
  158.    endif
  159.    
  160.    return (nAllowed)
  161.